home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / HardwareProjects / VideoText.lha / VideoText4.2 / source / VTview.p < prev   
Encoding:
Text File  |  1995-06-19  |  11.7 KB  |  363 lines
  1. PROGRAM VTview;
  2. FROM vt USES pagelist,decode,sys; {$opt q,s+,i+ }
  3. { Stellt roh abgespeicherte Videotextseiten auf einem eigenen Screen dar. }
  4. CONST version = '$VER: VTview 1.6  (19.06.95)';
  5.  
  6. {$incl "dos.lib", "workbench/startup.h", "icon.lib" }
  7.  
  8. VAR j, timing, countdown, anzseiten: integer;
  9.     auto, cycle, conceal: boolean;
  10.     taste,ch: Char;
  11.     titel,s: Str80; STATIC;
  12.     l: Long;
  13.  
  14. { ###################################################################### }
  15. { ------------------------- Dateibehandlung ---------------------------- }
  16. { ###################################################################### }
  17.  
  18. FUNCTION filetype(name: Str80): Integer;
  19. { Typcodierung: }
  20. { -1: Datei existiert nicht }
  21. {  0: unbekannter Typ (vermutlich roher ASCII-Text) }
  22. {  1: programmeigener Typ 'VTPG'=$56545047 }
  23. {  2: AmigaDOS-Programmdatei $000003F3 }
  24. {  3: IFF-Datei 'FORM'=$464F524D }
  25. {  4: Workbench-Icon $E310 }
  26. VAR head: Long;
  27.     i: Integer;
  28.     ch: Char;
  29.     datei: Text;
  30. BEGIN
  31.   Reset(datei,name);
  32.   IF IOresult=0 THEN BEGIN
  33.     filetype := 0;
  34.     head := 0;
  35.     FOR i := 1 TO 4 DO BEGIN
  36.       Read(datei,ch);
  37.       head := head SHL 8 + Ord(ch);
  38.       IF (i=2) AND (head=$E310) THEN filetype := 4;
  39.     END;
  40.     IF head=$56545047 THEN filetype := 1;
  41.     IF head=$000003F3 THEN filetype := 2;
  42.     IF head=$464F524D THEN filetype := 3;
  43.     Close(datei);
  44.   END ELSE
  45.     filetype := -1;
  46. END;
  47.  
  48. FUNCTION getpages(filename: Str80): Integer;
  49. { Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
  50. { einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
  51. VAR i,j, gelesen: Integer;
  52.     bytes: ^ARRAY[1..41] OF Char;
  53.     datei: Text;
  54.     zeile: Str80;
  55.     seite: p_onepage;
  56.     c: Char;
  57. PROCEDURE findword;
  58. { Hilft, zeile in Worte zu zerlegen. Parameter j: Startpunkt, Ergebnis: }
  59. { i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
  60. BEGIN
  61.   i := j; WHILE (zeile[i]=' ') AND (zeile[i]<>#0) DO Inc(i);
  62.   j := i + 1; WHILE NOT (zeile[j] IN [' ',#0]) DO Inc(j);
  63. END;
  64. BEGIN
  65.   gelesen := 0;
  66.   Reset(datei,filename);
  67.   IF (IOresult<>0) THEN     { Datei existiert nicht }
  68.     Exit;
  69.   Buffer(datei,200);
  70.   WHILE NOT EoF(datei) DO BEGIN
  71.     REPEAT
  72.       ReadLn(datei,zeile);
  73.     UNTIL (zeile='VTPG') OR EoF(datei);
  74.     if zeile='VTPG' THEN BEGIN
  75.       New(seite);
  76.       FOR i := 0 to 23 DO BEGIN
  77.         bytes := Ptr(^seite^.chars[40*i]);
  78.         BlockRead(datei,bytes^,40);
  79.         ReadLn(datei);
  80.       END;
  81.       ReadLn(datei,zeile); j := 1;
  82.       findword; seite^.pg := hexval(Copy(zeile,i,j-i));
  83.       findword; seite^.sp := hexval(Copy(zeile,i,j-i));
  84.       findword; seite^.cbits := hexval(Copy(zeile,i,j-i));
  85.       add_to_list(seite); Inc(gelesen);
  86.     END;
  87.   END;
  88.   Close(datei);
  89.   getpages := gelesen;
  90. END;
  91.  
  92. { ###################################################################### }
  93. { -------------------------- Bildschirmausgabe ------------------------- }
  94. { ###################################################################### }
  95.  
  96. PROCEDURE writepage(seite: p_onepage, verdeckt: Boolean);
  97. { Seite am Bildschirm ausgeben }
  98. CONST xoff = 1;
  99. VAR zeile,i,j,j0: Integer;
  100.     farbe,farbe0: Word;
  101.     out: bigstring;
  102.     x: Byte;
  103.     s,attrib: str80;
  104.     dblheight,rastergfx,special: Boolean;
  105.     normal: String[10];
  106. BEGIN
  107.   normal := #155'0;3'+colperms[7]+';4'+colperms[0]+'m'; { weiß auf schwarz }
  108.   dblheight := False; rastergfx := False;
  109.   seite^.chars[0] := 2;  { Seitennummer zunächst grün }
  110.   for i := 0 to 24 do begin
  111.     zeile := i MOD 24;
  112.     IF i=24 THEN BEGIN
  113.       { Überreste von doppelthohen Zeichen in der untersten Zeile einer }
  114.       { alten Seite löschen: }
  115.       IF NOT dblheight THEN BEGIN
  116.         GotoXY(xoff,25); Write(#155'0m',blank40,' ');
  117.       END;
  118.       { 1. Zeile nochmal, mit weißer Seitennummer: }
  119.       IF seite<>Nil THEN seite^.chars[0] := 7;
  120.       dblheight := False;
  121.     END;
  122.     IF dblheight THEN
  123.       { auf eine doppelthohe Zeile folgt nur eine leere Zeile }
  124.       dblheight := False
  125.     ELSE BEGIN
  126.       { normale Zeile ausgeben }
  127.       IF seite<>Nil THEN
  128.         decode_line(seite, zeile, verdeckt, out, attrib, dblheight, rastergfx)
  129.       ELSE
  130.         out := blank40;
  131.       GotoXY(xoff,zeile+1); Write(normal,out,normal,' ');
  132.       IF rastergfx THEN BEGIN  { Zeile, die gerasterte Grafikzeichen enthält }
  133.         special := False; farbe := 0;
  134.         FOR j := 0 TO 39 DO BEGIN  { zu rasternde Abschnitte suchen }
  135.           farbe0 := farbe; farbe := Ord(attrib[j+1]);
  136.           IF (farbe<>farbe0) AND special THEN BEGIN
  137.             raster_line(zeile+1,xoff+j0,xoff+j-1,farbe0 AND 7);
  138.             j0 := j; special := (farbe AND 16<>0);
  139.           END;
  140.           IF (farbe AND 16<>0) AND NOT special THEN BEGIN
  141.             j0 := j; special := True;
  142.           END;
  143.         END;
  144.         IF special THEN
  145.           raster_line(zeile+1,xoff+j0,xoff+39,farbe0 AND 7);
  146.       END;
  147.       IF dblheight THEN BEGIN   { Handhabung doppelthoher Zeilen }
  148.         special := False;
  149.         FOR j := 1 TO Length(out) DO BEGIN   { alles außer den ANSI-Codes }
  150.           { entfernen -> erzeugt Kopie der Hintergrundfarben der Zeile }
  151.           IF out[j] = #155 THEN special := True;
  152.           IF NOT special THEN out[j] := ' ';
  153.           IF out[j] = 'm' THEN special := False;
  154.         END;
  155.         GotoXY(xoff,zeile+2); Write(normal,out,normal,' ');
  156.         special := False;
  157.         FOR j := 0 TO 39 DO   { doppelthohe Abschnitte suchen }
  158.           CASE seite^.chars[40*zeile+j] OF
  159.             13: BEGIN j0 := j; special := True; END;
  160.             12: IF special THEN BEGIN
  161.                 stretch_line(zeile+1,xoff+j0,xoff+j); special := False;
  162.               END;
  163.             OTHERWISE;
  164.           END;
  165.         IF special THEN
  166.           stretch_line(zeile+1,xoff+j0,79);
  167.       END;
  168.     END;
  169.     lastkey := readkey; { Taste: Abbruch und Rückmeldung ans HP }
  170.     intui_events; { kann nicht schaden }
  171.     IF (lastkey<>chr(0)) OR stop THEN
  172.       Exit;
  173.   END;
  174. END;
  175.  
  176. { ###################################################################### }
  177. { -------------------------- Initialisierungen ------------------------- }
  178. { ###################################################################### }
  179.  
  180. PROCEDURE get_args;
  181. { Wertet CLI- oder WorkBench-Argumente aus: Die spezifizierten Dateien }
  182. { werden mit getpages() eingelesen. }
  183. { ToolTypes:                  CLI-Parameter:  }
  184. { MODE=MAN|AUTO|CYCLE         -a -c }
  185. { FLAGS=REVEAL|CONCEAL        -r }
  186. { TIMING=<secs>               -t<secs> }
  187. VAR c: char;
  188.     s: bigstring;
  189.     len,i,j,ok: integer;
  190.     hail: p_WBStartup;
  191.     arg: p_WBArg;
  192.     olddir: BPTR;
  193.     icon: p_DiskObject;
  194.     entry: Str;
  195.     name: Str80;
  196. FUNCTION is_space(ch: Char): Boolean;
  197. BEGIN  is_space := (ch=' ') OR (ch=#9) OR (ch=#10) OR (ch=#13);  END;
  198. BEGIN
  199.   conceal := True;
  200.   auto := False;
  201.   cycle := False;
  202.   timing := 2;
  203.   anzseiten := 0;
  204.   IF fromWB then BEGIN
  205.     OpenLib(IconBase,'icon.library',0);
  206.     hail := StartupMessage;
  207.     arg := hail^.sm_ArgList;
  208.     for i := 1 to hail^.sm_NumArgs do BEGIN
  209.       olddir := CurrentDir(arg^.wa_Lock);
  210.       name := arg^.wa_Name;
  211.       if filetype(name)=1 THEN    { nur VTPG-Dateien lesen }
  212.         anzseiten := anzseiten + getpages(name);
  213.       icon := GetDiskObject(arg^.wa_Name);
  214.       if icon<>Nil then BEGIN
  215.         entry := FindToolType(icon^.do_ToolTypes, 'MODE');
  216.         IF ptr(entry)<>Nil THEN BEGIN
  217.           IF MatchToolValue(entry,'MAN') THEN auto := False;
  218.           IF MatchToolValue(entry,'AUTO') THEN BEGIN
  219.             auto := True; cycle := False; END;
  220.           IF MatchToolValue(entry,'CYCLE') THEN BEGIN
  221.             auto := True; cycle := True; END;
  222.         END;
  223.         entry := FindToolType(icon^.do_ToolTypes, 'FLAGS');
  224.         IF ptr(entry)<>Nil THEN BEGIN
  225.           IF MatchToolValue(entry,'REVEAL') THEN conceal := False;
  226.           IF MatchToolValue(entry,'CONCEAL') THEN conceal := True;
  227.         END;
  228.         entry := FindToolType(icon^.do_ToolTypes, 'TIMING');
  229.         if ptr(entry)<>Nil then
  230.           Val(entry,timing,ok);
  231.         FreeDiskObject(icon);
  232.       END;
  233.       olddir := CurrentDir(olddir);
  234.       { auf nächsten WBArg-Zeiger zugreifen: }
  235.       arg := ptr(long(arg)+SizeOf(WBArg));
  236.     END;
  237.     CloseLib(IconBase);
  238.   end else if ParameterLen>0 then BEGIN
  239.     s := copy(ParameterStr,1,ParameterLen);
  240.     len := length(s);
  241.     { Parameterzeile in Worte zerlegen, wie der argv[] in C es schon ist :-( }
  242.     i := 1; while i<=len do BEGIN
  243.       while is_space(s[i]) do Inc(i);
  244.       j := i + 1;
  245.       if s[i]='"' then BEGIN
  246.         Inc(i); while (s[j]<>'"') AND (j<=len) do Inc(j);
  247.       end else BEGIN
  248.         while NOT is_space(s[j]) AND (j<=len) do Inc(j);
  249.       END;
  250.       { Zeiger i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
  251.       if s[i]='-' then BEGIN
  252.         i := i+2;
  253.         case s[i-1] of
  254.           't': Val(copy(s,i,j-i),timing,ok);
  255.           'r': conceal := False;
  256.           'a': auto := True;
  257.           'c': BEGIN auto := True; cycle := True; END;
  258.           otherwise BEGIN
  259.             writeln('usage:');
  260.             writeln('VTview <file> <file> ... -r[eveal] -a[uto] -c[ycle] -t<secs> ');
  261.             writeln('with <file> containing raw VideoText pages ("VTPG" format)');
  262.           END;
  263.         END;
  264.       END ELSE
  265.         IF filetype(copy(s,i,j-i))=1 THEN
  266.           anzseiten := anzseiten + getpages(copy(s,i,j-i))
  267.         ELSE
  268.           Writeln('Keine VTPG-Datei: ',copy(s,i,j-i));
  269.       i := j + 1;
  270.     END;
  271.   END;
  272. END;
  273.  
  274. { ###################################################################### }
  275. { ------------------ Hauptprogramm/Ereignisverwaltung ------------------ }
  276. { ###################################################################### }
  277.  
  278. PROCEDURE handle_escseq(chars: str80);
  279. { wie handle_key, aber für die ESC-Sequenzen der Sondertasten }
  280. VAR i,page,page2: Integer;
  281. BEGIN
  282.   { Cursor: Seitenliste durchblättern }
  283.   IF Pos(chars,'ABCDST')>0 THEN BEGIN
  284.     IF thispage<>Nil THEN
  285.       CASE chars[1] OF
  286.         'A': IF (thispage^.prev<>Nil) THEN
  287.           thispage := thispage^.prev;
  288.         'B': IF (thispage^.next<>Nil) THEN
  289.           thispage := thispage^.next;
  290.         'S': thispage := next_magazine(thispage);
  291.         'T': thispage := prev_magazine(thispage);
  292.         'C': WHILE (thispage^.next<>Nil) DO
  293.           thispage := thispage^.next;
  294.         'D': thispage := root;
  295.         OTHERWISE;
  296.       END;
  297.     writepage(thispage,conceal);
  298.   END;
  299. END;
  300.  
  301. PROCEDURE handle_key(key: char);
  302. VAR j,ok,ft: integer;
  303.     s: Str80;
  304. BEGIN
  305.   case key of
  306.     #27: stop := True;
  307.     #127: if thispage<>Nil then BEGIN  { Del: eine Seite löschen }
  308.           del_from_list(thispage);
  309.           writepage(Nil,true);
  310.         END;
  311.     ' ': writepage(thispage,true);
  312.     '?': writepage(thispage,false);
  313.     #155: BEGIN { Sondertasten auswerten }
  314.         s := '';
  315.         REPEAT  ch := readkey; s := s + ch;  UNTIL ch >= '@';
  316.         handle_escseq(s);
  317.       END;
  318.     OTHERWISE;
  319.   END;
  320. END;
  321.  
  322. BEGIN   { Hauptprogramm }
  323.   get_args;   { Parameter holen, Seiten einlesen }
  324.   titel := Copy(version,1,17)+' ('+IntStr(anzseiten)+' pages)  ESC to quit';
  325.   colperm := $01234567; colperms := '01234567';
  326.   AddExitServer(sysclean); sysinit(titel);
  327.   Write(#155'0 p'); { Cursor aus }
  328.   countdown := timing;
  329.   lastkey := #0; stop := False;
  330.   thispage := root;
  331.   writepage(thispage,conceal);
  332.   REPEAT
  333.     intui_events; { Msg-Port abfragen }
  334.     IF lastkey=#0 THEN
  335.       taste := readkey
  336.     ELSE BEGIN
  337.       taste := lastkey; lastkey := #0;
  338.     END;
  339.     IF taste<>#0 THEN BEGIN
  340.       auto := False;
  341.       handle_key(taste)
  342.     END ELSE IF auto THEN BEGIN
  343.       Delay(50); Dec(countdown);
  344.       IF countdown<=0 THEN
  345.         IF thispage<>Nil THEN BEGIN
  346.           IF thispage^.next=Nil THEN
  347.             IF cycle THEN thispage := root ELSE stop := True
  348.           ELSE
  349.             thispage := thispage^.next;
  350.           IF NOT stop THEN BEGIN
  351.             writepage(thispage,conceal);
  352.             countdown := timing;
  353.           END;
  354.         END ELSE
  355.           stop := True;
  356.     END ELSE
  357.       l := Wait(-1);
  358.   UNTIL stop;
  359.   SetStdIO(Nil); CloseConsole(Con);
  360.   kill_list; sysclean;
  361. END.
  362.  
  363.